home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / B-Book Series / (k)b8.d64 / demo 4.1.a.l < prev    next >
Text File  |  2007-02-28  |  878b  |  54 lines
  1. 0010 PROC INIT 
  2. 0020 SETGRAPHIC 0
  3. 0030 HIDETURTLE 
  4. 0040 FULLSCREEN 
  5. 0050 BACKGROUND 0
  6. 0060 BORDER 0
  7. 0070 ENDPROC INIT
  8. 0080 //
  9. 0090 PROC SQUARE(H,V,L) CLOSED
  10. 0100 MOVETO H,V
  11. 0110 FOR I:=1 TO 2 DO
  12. 0120 FORWARD L*.75
  13. 0130 RIGHT 90
  14. 0140 FORWARD L
  15. 0150 RIGHT 90
  16. 0160 ENDFOR I
  17. 0170 ENDPROC SQUARE
  18. 0180 //
  19. 0190 PROC POLY(H,V,L,S) CLOSED
  20. 0200 MOVETO H,V
  21. 0210 FOR I:=1 TO S DO
  22. 0220 FORWARD L
  23. 0230 RIGHT 360/S
  24. 0240 ENDFOR I
  25. 0250 ENDPROC POLY
  26. 0260 //
  27. 0270 INIT
  28. 0280 COUNTER:=0
  29. 0290 REPEAT 
  30. 0300 COUNTER:=COUNTER+1
  31. 0310 SCALE:=RND(5,40)
  32. 0320 L:=RND(5,40)
  33. 0330 S:=RND(3,8)
  34. 0340 H:=RND(0,320)
  35. 0350 V:=RND(0,200)
  36. 0360 PENCOLOR RND(1,15)
  37. 0370 CT:=RND(1,3)
  38. 0380 CASE CT OF
  39. 0390 WHEN 1
  40. 0400 POLY(H,V,L,S)
  41. 0410 IF COUNTER>20 THEN
  42. 0420 COUNTER:=0
  43. 0430 CLEAR 
  44. 0440 ELSE 
  45. 0450 NULL
  46. 0460 ENDIF 
  47. 0470 WHEN 2
  48. 0480 SQUARE(H,V,L)
  49. 0490 OTHERWISE 
  50. 0500 NULL
  51. 0510 ENDCASE 
  52. 0520 UNTIL KEY$<>CHR$(0)
  53. 0530 END 
  54.